home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
jx4nt123.zip
/
UTILS
/
YIQING.UTF
(
.txt
)
< prev
Wrap
Null Bytes Alternating
|
1994-09-02
|
4KB
|
99 lines
\ YiQing.utf .. Yi Qing Oracle Jax4th NT Version
\ Copyright (c) 1990, 1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 2400/9600/14400
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ $Revision$
\
\ ~~~~~~~~~~~~~~~~~~~~
\ Conditional INCLUDED
\ ~~~~~~~~~~~~~~~~~~~~
: PROVIDES ( c-addr u "ccc< >" --)
BL WORD FIND NIP 0=
IF INCLUDED ELSE 2DROP THEN ;
S" UTILS\UTILS.UTF" PROVIDES USEFUL
S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY
CR .( Loading Yi Qing Oracle words) CR
USEFUL
: NOT INVERT ;
USEFUL INTERNALS-WORDLIST ALSO-WID DEFINITIONS
HEX
S" GetSystemTime" KERNEL32 SYSTEMCALL GETSYSTIME
CREATE _sysTime 4 CELLS ALLOT
: SYSTEMTIME ( --)
OPEN-ALL RESOLVE-ALL
_sysTime DATATOABS GETSYSTIME 2DROP
CLOSE-ALL
;
SYSTEM-WORDLIST ALSO-WID DEFINITIONS
\ ~~~~~~~~~~~~~~~
MARKER yiqing.utf
\ ~~~~~~~~~~~~~~~
\ We can always forget back to here.
\ It's not safe to forget back past GETSYSTIME
\ because of the linked lists involved in our syscall
\ scheme.
: SYSTEMTIME ( -- wYear wMonth wDoW wDay wHr wMin wSec wMsec)
SYSTEMTIME
8 0
DO
I CHARS _sysTime + C@
LOOP
;
USEFUL HEX
2 CONSTANT YIN 3 CONSTANT YANG
: YIN? YANG MOD 0= NOT ;
: YANG? YIN MOD ;
: STALK DUP YANG? SWAP YIN? ;
: YARROW ABS 4 MOD 6 + ;
: RIGHTEOUS YARROW STALK ;
: PLACES
8 SPACES DUP ." ***"
IF ." ***" ELSE 3 SPACES THEN ." ***" ;
: BREAKS
3 SPACES SWAP
IF DROP ELSE IF ." -0-" ELSE ." -X-" THEN THEN ;
: CAST KEY SYSTEMTIME + + + + + + + + ;
: READING PLACES BREAKS CR ;
: ORACLE CR CR 6 0 DO CAST RIGHTEOUS READING LOOP ;
DECIMAL
\ End of YiQing.utf